home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tkEvent.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-06-21  |  51.0 KB  |  1,853 lines
  1. /* 
  2.  * tkEvent.c --
  3.  *
  4.  *    This file provides basic event-managing facilities, whereby
  5.  *    procedure callbacks may be attached to certain events.  It
  6.  *    also contains the command procedures for the commands "after"
  7.  *    and "fileevent", plus abridged versions of "tkwait" and
  8.  *    "update", for use with Tk_EventInit.
  9.  *
  10.  * Copyright (c) 1990-1994 The Regents of the University of California.
  11.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  */
  16.  
  17. static char sccsid[] = "@(#) tkEvent.c 1.97 95/06/21 15:16:33";
  18.  
  19. #include "tkPort.h"
  20. #include "tkInt.h"
  21. #include <errno.h>
  22.  
  23. /*
  24.  * For each timer callback that's pending, there is one record
  25.  * of the following type, chained together in a list sorted by
  26.  * time (earliest event first).
  27.  */
  28.  
  29. typedef struct TimerEvent {
  30.     struct timeval time;    /* When timer is to fire. */
  31.     void (*proc)  _ANSI_ARGS_((ClientData clientData));
  32.                 /* Procedure to call. */
  33.     ClientData clientData;    /* Argument to pass to proc. */
  34.     Tk_TimerToken token;    /* Identifies event so it can be
  35.                  * deleted. */
  36.     struct TimerEvent *nextPtr;    /* Next event in queue, or NULL for
  37.                  * end of queue. */
  38. } TimerEvent;
  39.  
  40. static TimerEvent *firstTimerHandlerPtr;
  41.                 /* First event in queue. */
  42.  
  43. /*
  44.  * The information below is used to provide read, write, and
  45.  * exception masks to select during calls to Tk_DoOneEvent.
  46.  */
  47.  
  48. static fd_mask ready[3*MASK_SIZE];
  49.                 /* Masks passed to select and modified
  50.                  * by kernel to indicate which files are
  51.                  * actually ready. */
  52. static fd_mask check[3*MASK_SIZE];
  53.                 /* Temporary set of masks, built up during
  54.                  * Tk_DoOneEvent, that reflects what files
  55.                  * we should wait for in the next select
  56.                  * (doesn't include things that we've been
  57.                  * asked to ignore in this call). */
  58. static int numFds = 0;        /* Number of valid bits in mask
  59.                  * arrays (this value is passed
  60.                  * to select). */
  61.  
  62. /*
  63.  * For each file registered in a call to Tk_CreateFileHandler,
  64.  * and for each display that's currently active, there is one
  65.  * record of the following type.  All of these records are
  66.  * chained together into a single list.
  67.  */
  68.  
  69. typedef struct FileHandler {
  70.     int fd;            /* POSIX file descriptor for file. */
  71.     fd_mask *readPtr;        /* Pointer to word in ready array
  72.                  * for this file's read mask bit. */
  73.     fd_mask *writePtr;        /* Same for write mask bit. */
  74.     fd_mask *exceptPtr;        /* Same for except mask bit. */
  75.     fd_mask *checkReadPtr;    /* Pointer to word in check array for
  76.                  * this file's read mask bit. */
  77.     fd_mask *checkWritePtr;    /* Same for write mask bit. */
  78.     fd_mask *checkExceptPtr;    /* Same for except mask bit. */
  79.     fd_mask bitSelect;        /* Value to AND with *readPtr etc. to
  80.                  * select just this file's bit. */
  81.     int mask;            /* Mask of desired events: TK_READABLE, etc. */
  82.     Tk_FileProc *proc;        /* Procedure to call, in the style of
  83.                  * Tk_CreateFileHandler.  This is NULL
  84.                  * if the handler was created by
  85.                  * Tk_CreateFileHandler2. */
  86.     Tk_FileProc2 *proc2;    /* Procedure to call, in the style of
  87.                  * Tk_CreateFileHandler2.  NULL means that
  88.                  * the handler was created by
  89.                  * Tk_CreateFileHandler. */
  90.     ClientData clientData;    /* Argument to pass to proc. */
  91.     struct FileHandler *nextPtr;/* Next in list of all files we
  92.                  * care about (NULL for end of
  93.                  * list). */
  94. } FileHandler;
  95.  
  96. static FileHandler *firstFileHandlerPtr;
  97.                 /* List of all file events. */
  98.  
  99. /*
  100.  * There is one of the following structures for each of the
  101.  * handlers declared in a call to Tk_DoWhenIdle.  All of the
  102.  * currently-active handlers are linked together into a list.
  103.  */
  104.  
  105. typedef struct IdleHandler {
  106.     void (*proc)  _ANSI_ARGS_((ClientData clientData));
  107.                 /* Procedure to call. */
  108.     ClientData clientData;    /* Value to pass to proc. */
  109.     int generation;        /* Used to distinguish older handlers from
  110.                  * recently-created ones. */
  111.     struct IdleHandler *nextPtr;/* Next in list of active handlers. */
  112. } IdleHandler;
  113.  
  114. static IdleHandler *idleList = NULL;
  115.                 /* First in list of all idle handlers. */
  116. static IdleHandler *lastIdlePtr = NULL;
  117.                 /* Last in list (or NULL for empty list). */
  118. static int idleGeneration = 0;    /* Used to fill in the "generation" fields
  119.                  * of IdleHandler structures.  Increments
  120.                  * each time Tk_DoOneEvent starts calling
  121.                  * idle handlers, so that all old handlers
  122.                  * can be called without calling any of the
  123.                  * new ones created by old ones. */
  124.  
  125. /*
  126.  * The following procedure provides a secret hook for tkXEvent.c so that
  127.  * it can handle delayed mouse motion events at the right time.
  128.  */
  129.  
  130. void (*tkDelayedEventProc) _ANSI_ARGS_((void)) = NULL;
  131.  
  132. /*
  133.  * One of the following structures exists for each file with a handler
  134.  * created by the "fileevent" command.  Several of the fields are
  135.  * two-element arrays, in which the first element is used for read
  136.  * events and the second for write events.
  137.  */
  138.  
  139. typedef struct FileEvent {
  140.     FILE *f;                /* Stdio handle for file. */
  141.     Tcl_Interp *interps[2];        /* Interpreters in which to execute
  142.                      * scripts.  NULL means no handler
  143.                      * for event. */
  144.     char *scripts[2];            /* Scripts to evaluate in response to
  145.                      * events (malloc'ed).  NULL means no
  146.                      * handler for event. */
  147.     struct FileEvent *nextPtr;        /* Next in list of all file events
  148.                      * currently defined. */
  149. } FileEvent;
  150.  
  151. static FileEvent *firstFileEventPtr = NULL;
  152.                     /* First in list of all existing
  153.                      * file events. */
  154.  
  155. /*
  156.  * The data structure below is used by the "after" command to remember
  157.  * the command to be executed later.
  158.  */
  159.  
  160. typedef struct AfterInfo {
  161.     Tcl_Interp *interp;        /* Interpreter in which to execute command. */
  162.     char *command;        /* Command to execute.  Malloc'ed, so must
  163.                  * be freed when structure is deallocated. */
  164.     int id;            /* Integer identifier for command;  used to
  165.                  * cancel it. */
  166.     Tk_TimerToken token;    /* Used to cancel the "after" command.  NULL
  167.                  * means that the command is run as an
  168.                  * idle handler rather than as a timer
  169.                  * handler. */
  170.     struct AfterInfo *nextPtr;    /* Next in list of all "after" commands for
  171.                  * the application. */
  172. } AfterInfo;
  173.  
  174. static AfterInfo *firstAfterPtr = NULL;
  175.                 /* First in list of all pending "after"
  176.                  * commands. */
  177.  
  178. /*
  179.  * The data structure below is used to report background errors.  One
  180.  * such structure is allocated for each error;  it holds information
  181.  * about the interpreter and the error until tkerror can be invoked
  182.  * later as an idle handler.
  183.  */
  184.  
  185. typedef struct BgError {
  186.     Tcl_Interp *interp;        /* Interpreter in which error occurred.  NULL
  187.                  * means this error report has been cancelled
  188.                  * (a previous report generated a break). */
  189.     char *errorMsg;        /* The error message (interp->result when
  190.                  * the error occurred).  Malloc-ed. */
  191.     char *errorInfo;        /* Value of the errorInfo variable
  192.                  * (malloc-ed). */
  193.     char *errorCode;        /* Value of the errorCode variable
  194.                  * (malloc-ed). */
  195.     struct BgError *nextPtr;    /* Next in list of all pending error
  196.                  * reports. */
  197. } BgError;
  198.  
  199. static BgError *firstBgPtr = NULL;
  200.                 /* First in list of all background errors
  201.                  * waiting to be processed (NULL if none). */
  202. static BgError *lastBgPtr = NULL;
  203.                 /* First in list of all background errors
  204.                  * waiting to be processed (NULL if none). */
  205.  
  206. /*
  207.  * Prototypes for procedures referenced only in this file:
  208.  */
  209.  
  210. static void        AfterProc _ANSI_ARGS_((ClientData clientData));
  211. static void        DeleteFileEvent _ANSI_ARGS_((FILE *f));
  212. static int        FileEventProc _ANSI_ARGS_((ClientData clientData,
  213.                 int mask, int flags));
  214. static void        FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
  215. static void        HandleBgErrors _ANSI_ARGS_((ClientData clientData));
  216. static int        TkwaitCmd2 _ANSI_ARGS_((ClientData clientData,
  217.                 Tcl_Interp *interp, int argc, char **argv));
  218. static int        UpdateCmd2 _ANSI_ARGS_((ClientData clientData,
  219.                 Tcl_Interp *interp, int argc, char **argv));
  220. static char *        WaitVariableProc2 _ANSI_ARGS_((ClientData clientData,
  221.                 Tcl_Interp *interp, char *name1, char *name2,
  222.                 int flags));
  223.  
  224. /*
  225.  *--------------------------------------------------------------
  226.  *
  227.  * Tk_CreateFileHandler --
  228.  *
  229.  *    Arrange for a given procedure to be invoked whenever
  230.  *    a given file becomes readable or writable.
  231.  *
  232.  * Results:
  233.  *    None.
  234.  *
  235.  * Side effects:
  236.  *    From now on, whenever the I/O channel given by fd becomes
  237.  *    ready in the way indicated by mask, proc will be invoked.
  238.  *    See the manual entry for details on the calling sequence
  239.  *    to proc.  If fd is already registered then the old mask
  240.  *    and proc and clientData values will be replaced with
  241.  *    new ones.
  242.  *
  243.  *--------------------------------------------------------------
  244.  */
  245.  
  246. void
  247. Tk_CreateFileHandler(fd, mask, proc, clientData)
  248.     int fd;            /* Integer identifier for stream. */
  249.     int mask;            /* OR'ed combination of TK_READABLE,
  250.                  * TK_WRITABLE, and TK_EXCEPTION:
  251.                  * indicates conditions under which
  252.                  * proc should be called.  TK_IS_DISPLAY
  253.                  * indicates that this is a display and that
  254.                  * clientData is the (Display *) for it,
  255.                  * and that events should be handled
  256.                  * automatically.*/
  257.     Tk_FileProc *proc;        /* Procedure to call for each
  258.                  * selected event. */
  259.     ClientData clientData;    /* Arbitrary data to pass to proc. */
  260. {
  261.     register FileHandler *filePtr;
  262.     int index;
  263.  
  264.     if (fd >= OPEN_MAX) {
  265.     panic("Tk_CreatefileHandler can't handle file id %d", fd);
  266.     }
  267.  
  268.     /*
  269.      * Make sure the file isn't already registered.  Create a
  270.      * new record in the normal case where there's no existing
  271.      * record.
  272.      */
  273.  
  274.     for (filePtr = firstFileHandlerPtr; filePtr != NULL;
  275.         filePtr = filePtr->nextPtr) {
  276.     if (filePtr->fd == fd) {
  277.         break;
  278.     }
  279.     }
  280.     index = fd/(NBBY*sizeof(fd_mask));
  281.     if (filePtr == NULL) {
  282.     filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
  283.     filePtr->fd = fd;
  284.     filePtr->readPtr = &ready[index];
  285.     filePtr->writePtr = &ready[index+MASK_SIZE];
  286.     filePtr->exceptPtr = &ready[index+2*MASK_SIZE];
  287.     filePtr->checkReadPtr = &check[index];
  288.     filePtr->checkWritePtr = &check[index+MASK_SIZE];
  289.     filePtr->checkExceptPtr = &check[index+2*MASK_SIZE];
  290.     filePtr->bitSelect = 1 << (fd%(NBBY*sizeof(fd_mask)));
  291.     filePtr->nextPtr = firstFileHandlerPtr;
  292.     firstFileHandlerPtr = filePtr;
  293.     }
  294.  
  295.     /*
  296.      * The remainder of the initialization below is done
  297.      * regardless of whether or not this is a new record
  298.      * or a modification of an old one.
  299.      */
  300.  
  301.     filePtr->mask = mask;
  302.     filePtr->proc = proc;
  303.     filePtr->proc2 = NULL;
  304.     filePtr->clientData = clientData;
  305.  
  306.     if (numFds <= fd) {
  307.     numFds = fd+1;
  308.     }
  309. }
  310.  
  311. /*
  312.  *--------------------------------------------------------------
  313.  *
  314.  * Tk_CreateFileHandler2 --
  315.  *
  316.  *    Arrange for a given procedure to be invoked during the
  317.  *    event loop to handle a particular file.
  318.  *
  319.  * Results:
  320.  *    None.
  321.  *
  322.  * Side effects:
  323.  *    In each pass through Tk_DoOneEvent, proc will be invoked to
  324.  *    decide whether fd is "ready" and take appropriate action if
  325.  *    it is.  See the manual entry for details on the calling
  326.  *    sequence to proc.  If a handler for fd has already been
  327.  *    registered then it is superseded by the new one.
  328.  *
  329.  *--------------------------------------------------------------
  330.  */
  331.  
  332. void
  333. Tk_CreateFileHandler2(fd, proc, clientData)
  334.     int fd;            /* Integer identifier for stream. */
  335.     Tk_FileProc2 *proc;        /* Procedure to call from the event
  336.                  * dispatcher. */
  337.     ClientData clientData;    /* Arbitrary data to pass to proc. */
  338. {
  339.     register FileHandler *filePtr;
  340.  
  341.     /*
  342.      * Let Tk_CreateFileHandler do all of the work of setting up
  343.      * the handler, then just modify things a bit after it returns.
  344.      */
  345.  
  346.     Tk_CreateFileHandler(fd, 0, (Tk_FileProc *) NULL, clientData);
  347.     for (filePtr = firstFileHandlerPtr; filePtr->fd != fd;
  348.         filePtr = filePtr->nextPtr) {
  349.     /* Empty loop body. */
  350.     }
  351.     filePtr->proc = NULL;
  352.     filePtr->proc2 = proc;
  353. }
  354.  
  355. /*
  356.  *--------------------------------------------------------------
  357.  *
  358.  * Tk_DeleteFileHandler --
  359.  *
  360.  *    Cancel a previously-arranged callback arrangement for
  361.  *    a file.
  362.  *
  363.  * Results:
  364.  *    None.
  365.  *
  366.  * Side effects:
  367.  *    If a callback was previously registered on fd, remove it.
  368.  *
  369.  *--------------------------------------------------------------
  370.  */
  371.  
  372. void
  373. Tk_DeleteFileHandler(fd)
  374.     int fd;            /* Stream id for which to remove
  375.                  * callback procedure. */
  376. {
  377.     register FileHandler *filePtr;
  378.     FileHandler *prevPtr;
  379.  
  380.     /*
  381.      * Find the entry for the given file (and return if there
  382.      * isn't one).
  383.      */
  384.  
  385.     for (prevPtr = NULL, filePtr = firstFileHandlerPtr; ;
  386.         prevPtr = filePtr, filePtr = filePtr->nextPtr) {
  387.     if (filePtr == NULL) {
  388.         return;
  389.     }
  390.     if (filePtr->fd == fd) {
  391.         break;
  392.     }
  393.     }
  394.  
  395.     /*
  396.      * Clean up information in the callback record.
  397.      */
  398.  
  399.     if (prevPtr == NULL) {
  400.     firstFileHandlerPtr = filePtr->nextPtr;
  401.     } else {
  402.     prevPtr->nextPtr = filePtr->nextPtr;
  403.     }
  404.     ckfree((char *) filePtr);
  405.  
  406.     /*
  407.      * Recompute numFds.
  408.      */
  409.  
  410.     numFds = 0;
  411.     for (filePtr = firstFileHandlerPtr; filePtr != NULL;
  412.         filePtr = filePtr->nextPtr) {
  413.     if (numFds <= filePtr->fd) {
  414.         numFds = filePtr->fd+1;
  415.     }
  416.     }
  417. }
  418.  
  419. /*
  420.  *--------------------------------------------------------------
  421.  *
  422.  * Tk_CreateTimerHandler --
  423.  *
  424.  *    Arrange for a given procedure to be invoked at a particular
  425.  *    time in the future.
  426.  *
  427.  * Results:
  428.  *    The return value is a token for the timer event, which
  429.  *    may be used to delete the event before it fires.
  430.  *
  431.  * Side effects:
  432.  *    When milliseconds have elapsed, proc will be invoked
  433.  *    exactly once.
  434.  *
  435.  *--------------------------------------------------------------
  436.  */
  437.  
  438. Tk_TimerToken
  439. Tk_CreateTimerHandler(milliseconds, proc, clientData)
  440.     int milliseconds;        /* How many milliseconds to wait
  441.                  * before invoking proc. */
  442.     Tk_TimerProc *proc;        /* Procedure to invoke. */
  443.     ClientData clientData;    /* Arbitrary data to pass to proc. */
  444. {
  445.     register TimerEvent *timerPtr, *tPtr2, *prevPtr;
  446.     static int id = 0;
  447.  
  448.     timerPtr = (TimerEvent *) ckalloc(sizeof(TimerEvent));
  449.  
  450.     /*
  451.      * Compute when the event should fire.
  452.      */
  453.  
  454.     (void) gettimeofday(&timerPtr->time, (struct timezone *) NULL);
  455.     timerPtr->time.tv_sec += milliseconds/1000;
  456.     timerPtr->time.tv_usec += (milliseconds%1000)*1000;
  457.     if (timerPtr->time.tv_usec >= 1000000) {
  458.     timerPtr->time.tv_usec -= 1000000;
  459.     timerPtr->time.tv_sec += 1;
  460.     }
  461.  
  462.     /*
  463.      * Fill in other fields for the event.
  464.      */
  465.  
  466.     timerPtr->proc = proc;
  467.     timerPtr->clientData = clientData;
  468.     id++;
  469.     timerPtr->token = (Tk_TimerToken) id;
  470.  
  471.     /*
  472.      * Add the event to the queue in the correct position
  473.      * (ordered by event firing time).
  474.      */
  475.  
  476.     for (tPtr2 = firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
  477.         prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
  478.     if ((tPtr2->time.tv_sec > timerPtr->time.tv_sec)
  479.         || ((tPtr2->time.tv_sec == timerPtr->time.tv_sec)
  480.         && (tPtr2->time.tv_usec > timerPtr->time.tv_usec))) {
  481.         break;
  482.     }
  483.     }
  484.     if (prevPtr == NULL) {
  485.     timerPtr->nextPtr = firstTimerHandlerPtr;
  486.     firstTimerHandlerPtr = timerPtr;
  487.     } else {
  488.     timerPtr->nextPtr = prevPtr->nextPtr;
  489.     prevPtr->nextPtr = timerPtr;
  490.     }
  491.     return timerPtr->token;
  492. }
  493.  
  494. /*
  495.  *--------------------------------------------------------------
  496.  *
  497.  * Tk_DeleteTimerHandler --
  498.  *
  499.  *    Delete a previously-registered timer handler.
  500.  *
  501.  * Results:
  502.  *    None.
  503.  *
  504.  * Side effects:
  505.  *    Destroy the timer callback identified by TimerToken,
  506.  *    so that its associated procedure will not be called.
  507.  *    If the callback has already fired, or if the given
  508.  *    token doesn't exist, then nothing happens.
  509.  *
  510.  *--------------------------------------------------------------
  511.  */
  512.  
  513. void
  514. Tk_DeleteTimerHandler(token)
  515.     Tk_TimerToken token;    /* Result previously returned by
  516.                  * Tk_DeleteTimerHandler. */
  517. {
  518.     register TimerEvent *timerPtr, *prevPtr;
  519.  
  520.     for (timerPtr = firstTimerHandlerPtr, prevPtr = NULL; timerPtr != NULL;
  521.         prevPtr = timerPtr, timerPtr = timerPtr->nextPtr) {
  522.     if (timerPtr->token != token) {
  523.         continue;
  524.     }
  525.     if (prevPtr == NULL) {
  526.         firstTimerHandlerPtr = timerPtr->nextPtr;
  527.     } else {
  528.         prevPtr->nextPtr = timerPtr->nextPtr;
  529.     }
  530.     ckfree((char *) timerPtr);
  531.     return;
  532.     }
  533. }
  534.  
  535. /*
  536.  *--------------------------------------------------------------
  537.  *
  538.  * Tk_DoWhenIdle --
  539.  *
  540.  *    Arrange for proc to be invoked the next time the
  541.  *    system is idle (i.e., just before the next time
  542.  *    that Tk_DoOneEvent would have to wait for something
  543.  *    to happen).
  544.  *
  545.  * Results:
  546.  *    None.
  547.  *
  548.  * Side effects:
  549.  *    Proc will eventually be called, with clientData
  550.  *    as argument.  See the manual entry for details.
  551.  *
  552.  *--------------------------------------------------------------
  553.  */
  554.  
  555. void
  556. Tk_DoWhenIdle(proc, clientData)
  557.     Tk_IdleProc *proc;        /* Procedure to invoke. */
  558.     ClientData clientData;    /* Arbitrary value to pass to proc. */
  559. {
  560.     register IdleHandler *idlePtr;
  561.  
  562.     idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
  563.     idlePtr->proc = proc;
  564.     idlePtr->clientData = clientData;
  565.     idlePtr->generation = idleGeneration;
  566.     idlePtr->nextPtr = NULL;
  567.     if (lastIdlePtr == NULL) {
  568.     idleList = idlePtr;
  569.     } else {
  570.     lastIdlePtr->nextPtr = idlePtr;
  571.     }
  572.     lastIdlePtr = idlePtr;
  573. }
  574.  
  575. /*
  576.  *----------------------------------------------------------------------
  577.  *
  578.  * Tk_CancelIdleCall --
  579.  *
  580.  *    If there are any when-idle calls requested to a given procedure
  581.  *    with given clientData, cancel all of them.
  582.  *
  583.  * Results:
  584.  *    None.
  585.  *
  586.  * Side effects:
  587.  *    If the proc/clientData combination were on the when-idle list,
  588.  *    they are removed so that they will never be called.
  589.  *
  590.  *----------------------------------------------------------------------
  591.  */
  592.  
  593. void
  594. Tk_CancelIdleCall(proc, clientData)
  595.     Tk_IdleProc *proc;        /* Procedure that was previously registered. */
  596.     ClientData clientData;    /* Arbitrary value to pass to proc. */
  597. {
  598.     register IdleHandler *idlePtr, *prevPtr;
  599.     IdleHandler *nextPtr;
  600.  
  601.     for (prevPtr = NULL, idlePtr = idleList; idlePtr != NULL;
  602.         prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
  603.     while ((idlePtr->proc == proc)
  604.         && (idlePtr->clientData == clientData)) {
  605.         nextPtr = idlePtr->nextPtr;
  606.         ckfree((char *) idlePtr);
  607.         idlePtr = nextPtr;
  608.         if (prevPtr == NULL) {
  609.         idleList = idlePtr;
  610.         } else {
  611.         prevPtr->nextPtr = idlePtr;
  612.         }
  613.         if (idlePtr == NULL) {
  614.         lastIdlePtr = prevPtr;
  615.         return;
  616.         }
  617.     }
  618.     }
  619. }
  620.  
  621. /*
  622.  *--------------------------------------------------------------
  623.  *
  624.  * Tk_DoOneEvent --
  625.  *
  626.  *    Process a single event of some sort.  If there's no
  627.  *    work to do, wait for an event to occur, then process
  628.  *    it.
  629.  *
  630.  * Results:
  631.  *    The return value is 1 if the procedure actually found
  632.  *    an event to process.  If no event was found then 0 is
  633.  *    returned.
  634.  *
  635.  * Side effects:
  636.  *    May delay execution of process while waiting for an
  637.  *    X event, X error, file-ready event, or timer event.
  638.  *    The handling of the event could cause additional
  639.  *    side effects.  Collapses sequences of mouse-motion
  640.  *    events for the same window into a single event by
  641.  *    delaying motion event processing.
  642.  *
  643.  *--------------------------------------------------------------
  644.  */
  645.  
  646. int
  647. Tk_DoOneEvent(flags)
  648.     int flags;            /* Miscellaneous flag values:  may be any
  649.                  * combination of TK_DONT_WAIT, TK_X_EVENTS,
  650.                  * TK_FILE_EVENTS, TK_TIMER_EVENTS, and
  651.                  * TK_IDLE_EVENTS. */
  652. {
  653.     register FileHandler *filePtr;
  654.     struct timeval curTime, timeout, *timeoutPtr;
  655.     int numFound, mask, anyFilesToWaitFor;
  656.  
  657.     if ((flags & TK_ALL_EVENTS) == 0) {
  658.     flags |= TK_ALL_EVENTS;
  659.     }
  660.  
  661.     /*
  662.      * Phase One: see if there's a ready file that was left over
  663.      * from before (i.e don't do a select, just check the bits from
  664.      * the last select).
  665.      */
  666.  
  667.     checkFiles:
  668.     if (tcl_AsyncReady) {
  669.     (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
  670.     return 1;
  671.     }
  672.     memset((VOID *) check, 0, 3*MASK_SIZE*sizeof(fd_mask));
  673.     anyFilesToWaitFor = 0;
  674.     for (filePtr = firstFileHandlerPtr; filePtr != NULL;
  675.         filePtr = filePtr->nextPtr) {
  676.     mask = 0;
  677.     if (*filePtr->readPtr & filePtr->bitSelect) {
  678.         mask |= TK_READABLE;
  679.         *filePtr->readPtr &= ~filePtr->bitSelect;
  680.     }
  681.     if (*filePtr->writePtr & filePtr->bitSelect) {
  682.         mask |= TK_WRITABLE;
  683.         *filePtr->writePtr &= ~filePtr->bitSelect;
  684.     }
  685.     if (*filePtr->exceptPtr & filePtr->bitSelect) {
  686.         mask |= TK_EXCEPTION;
  687.         *filePtr->exceptPtr &= ~filePtr->bitSelect;
  688.     }
  689.     if (filePtr->proc2 != NULL) {
  690.         /*
  691.          * Handler created by Tk_CreateFileHandler2.
  692.          */
  693.  
  694.         mask = (*filePtr->proc2)(filePtr->clientData, mask, flags);
  695.         if (mask == TK_FILE_HANDLED) {
  696.         return 1;
  697.         }
  698.     } else {
  699.         /*
  700.          * Handler created by Tk_CreateFileHandler.
  701.          */
  702.  
  703.         if (!(flags & TK_FILE_EVENTS)) {
  704.         continue;
  705.         }
  706.         if (mask != 0) {
  707.         (*filePtr->proc)(filePtr->clientData, mask);
  708.         return 1;
  709.         }
  710.         mask = filePtr->mask;
  711.     }
  712.     if (mask != 0) {
  713.         anyFilesToWaitFor = 1;
  714.         if (mask & TK_READABLE) {
  715.         *filePtr->checkReadPtr |= filePtr->bitSelect;
  716.         }
  717.         if (mask & TK_WRITABLE) {
  718.         *filePtr->checkWritePtr |= filePtr->bitSelect;
  719.         }
  720.         if (mask & TK_EXCEPTION) {
  721.         *filePtr->checkExceptPtr |= filePtr->bitSelect;
  722.         }
  723.     }
  724.     }
  725.  
  726.     /*
  727.      * Phase Two: get the current time and see if any timer
  728.      * events are ready to fire.  If so, fire one and return.
  729.      */
  730.  
  731.     checkTime:
  732.     if ((firstTimerHandlerPtr != NULL) && (flags & TK_TIMER_EVENTS)) {
  733.     register TimerEvent *timerPtr = firstTimerHandlerPtr;
  734.  
  735.     (void) gettimeofday(&curTime, (struct timezone *) NULL);
  736.     if ((timerPtr->time.tv_sec < curTime.tv_sec)
  737.         || ((timerPtr->time.tv_sec == curTime.tv_sec)
  738.         &&  (timerPtr->time.tv_usec < curTime.tv_usec))) {
  739.         firstTimerHandlerPtr = timerPtr->nextPtr;
  740.         (*timerPtr->proc)(timerPtr->clientData);
  741.         ckfree((char *) timerPtr);
  742.         return 1;
  743.     }
  744.     }
  745.  
  746.     /*
  747.      * Phase Three: if there are DoWhenIdle requests pending (or
  748.      * if we're not allowed to block), then do a select with an
  749.      * instantaneous timeout.  If a ready file is found, then go
  750.      * back to process it.
  751.      */
  752.  
  753.     if (((idleList != NULL) && (flags & TK_IDLE_EVENTS))
  754.         || (flags & TK_DONT_WAIT)) {
  755.     if (flags & (TK_X_EVENTS|TK_FILE_EVENTS)) {
  756.         memcpy((VOID *) ready, (VOID *) check,
  757.             3*MASK_SIZE*sizeof(fd_mask));
  758.         timeout.tv_sec = timeout.tv_usec = 0;
  759.         numFound = select(numFds, (SELECT_MASK *) &ready[0],
  760.             (SELECT_MASK *) &ready[MASK_SIZE],
  761.             (SELECT_MASK *) &ready[2*MASK_SIZE], &timeout);
  762.         if (numFound <= 0) {
  763.         /*
  764.          * Some systems don't clear the masks after an error, so
  765.          * we have to do it here.
  766.          */
  767.  
  768.         memset((VOID *) ready, 0, 3*MASK_SIZE*sizeof(fd_mask));
  769.         }
  770.         if ((numFound > 0) || ((numFound == -1) && (errno == EINTR))) {
  771.         goto checkFiles;
  772.         }
  773.     }
  774.     }
  775.  
  776.     /*
  777.      * Phase Four: if there is a delayed motion event then call a procedure
  778.      * to handle it.  Do it now, before calling any DoWhenIdle handlers,
  779.      * since the goal of idle handlers is to delay until after all pending
  780.      * events have been processed.
  781.      *
  782.      * The particular implementation of this (a procedure variable shared
  783.      * with tkXEvent.c) is a bit kludgy, but it allows this file to be used
  784.      * separately without any of the rest of Tk.
  785.      */
  786.  
  787.     if ((tkDelayedEventProc != NULL) && (flags & TK_X_EVENTS)) {
  788.     (*tkDelayedEventProc)();
  789.     return 1;
  790.     }
  791.  
  792.     /*
  793.      * Phase Five:  process all pending DoWhenIdle requests.
  794.      */
  795.  
  796.     if ((idleList != NULL) && (flags & TK_IDLE_EVENTS)) {
  797.     register IdleHandler *idlePtr;
  798.     int oldGeneration;
  799.  
  800.     oldGeneration = idleList->generation;
  801.     idleGeneration++;
  802.  
  803.     /*
  804.      * The code below is trickier than it may look, for the following
  805.      * reasons:
  806.      *
  807.      * 1. New handlers can get added to the list while the current
  808.      *    one is being processed.  If new ones get added, we don't
  809.      *    want to process them during this pass through the list (want
  810.      *    to check for other work to do first).  This is implemented
  811.      *    using the generation number in the handler:  new handlers
  812.      *    will have a different generation than any of the ones currently
  813.      *    on the list.
  814.      * 2. The handler can call Tk_DoOneEvent, so we have to remove
  815.      *    the hander from the list before calling it. Otherwise an
  816.      *    infinite loop could result.
  817.      * 3. Tk_CancelIdleCall can be called to remove an element from
  818.      *    the list while a handler is executing, so the list could
  819.      *    change structure during the call.
  820.      */
  821.  
  822.     for (idlePtr = idleList;
  823.         ((idlePtr != NULL) && (idlePtr->generation == oldGeneration));
  824.         idlePtr = idleList) {
  825.         idleList = idlePtr->nextPtr;
  826.         if (idleList == NULL) {
  827.         lastIdlePtr = NULL;
  828.         }
  829.         (*idlePtr->proc)(idlePtr->clientData);
  830.         ckfree((char *) idlePtr);
  831.     }
  832.     return 1;
  833.     }
  834.  
  835.     /*
  836.      * Phase Six: do a select to wait for either one of the
  837.      * files to become ready or for the first timer event to
  838.      * fire.  Then go back to process the event.
  839.      */
  840.  
  841.     if ((flags & TK_DONT_WAIT)
  842.         || !(flags & (TK_TIMER_EVENTS|TK_FILE_EVENTS|TK_X_EVENTS))) {
  843.     return 0;
  844.     }
  845.     if ((firstTimerHandlerPtr == NULL) || !(flags & TK_TIMER_EVENTS)) {
  846.     timeoutPtr = NULL;
  847.     } else {
  848.     timeoutPtr = &timeout;
  849.     timeout.tv_sec = firstTimerHandlerPtr->time.tv_sec - curTime.tv_sec;
  850.     timeout.tv_usec = firstTimerHandlerPtr->time.tv_usec - curTime.tv_usec;
  851.     if (timeout.tv_usec < 0) {
  852.         timeout.tv_sec -= 1;
  853.         timeout.tv_usec += 1000000;
  854.     }
  855.     }
  856.     if ((timeoutPtr == NULL) && !anyFilesToWaitFor) {
  857.     return 0;
  858.     }
  859.     memcpy((VOID *) ready, (VOID *) check, 3*MASK_SIZE*sizeof(fd_mask));
  860.     numFound = select(numFds, (SELECT_MASK *) &ready[0],
  861.         (SELECT_MASK *) &ready[MASK_SIZE],
  862.         (SELECT_MASK *) &ready[2*MASK_SIZE], timeoutPtr);
  863.     if (numFound == -1) {
  864.     /*
  865.      * Some systems don't clear the masks after an error, so
  866.      * we have to do it here.
  867.      */
  868.  
  869.     memset((VOID *) ready, 0, 3*MASK_SIZE*sizeof(fd_mask));
  870.     }
  871.     if (numFound == 0) {
  872.     goto checkTime;
  873.     }
  874.     goto checkFiles;
  875. }
  876.  
  877. /*
  878.  *----------------------------------------------------------------------
  879.  *
  880.  * Tk_Sleep --
  881.  *
  882.  *    Delay execution for the specified number of milliseconds.
  883.  *
  884.  * Results:
  885.  *    None.
  886.  *
  887.  * Side effects:
  888.  *    Time passes.
  889.  *
  890.  *----------------------------------------------------------------------
  891.  */
  892.  
  893. void
  894. Tk_Sleep(ms)
  895.     int ms;            /* Number of milliseconds to sleep. */
  896. {
  897.     static struct timeval delay;
  898.  
  899.     delay.tv_sec = ms/1000;
  900.     delay.tv_usec = (ms%1000)*1000;
  901.     (void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
  902.         (SELECT_MASK *) 0, &delay);
  903. }
  904.  
  905. /*
  906.  *----------------------------------------------------------------------
  907.  *
  908.  * Tk_BackgroundError --
  909.  *
  910.  *    This procedure is invoked to handle errors that occur in Tcl
  911.  *    commands that are invoked in "background" (e.g. from event or
  912.  *    timer bindings).
  913.  *
  914.  * Results:
  915.  *    None.
  916.  *
  917.  * Side effects:
  918.  *    The command "tkerror" is invoked later as an idle handler to
  919.  *    process the error, passing it the error message.  If that fails,
  920.  *    then an error message is output on stderr.
  921.  *
  922.  *----------------------------------------------------------------------
  923.  */
  924.  
  925. void
  926. Tk_BackgroundError(interp)
  927.     Tcl_Interp *interp;        /* Interpreter in which an error has
  928.                  * occurred. */
  929. {
  930.     BgError *errPtr;
  931.     char *varValue;
  932.  
  933.     /*
  934.      * The Tcl_AddErrorInfo call below (with an empty string) ensures that
  935.      * errorInfo gets properly set.  It's needed in cases where the error
  936.      * came from a utility procedure like Tcl_GetVar instead of Tcl_Eval;
  937.      * in these cases errorInfo still won't have been set when this
  938.      * procedure is called.
  939.      */
  940.  
  941.     Tcl_AddErrorInfo(interp, "");
  942.     errPtr = (BgError *) ckalloc(sizeof(BgError));
  943.     errPtr->interp = interp;
  944.     errPtr->errorMsg = (char *) ckalloc((unsigned) (strlen(interp->result)
  945.         + 1));
  946.     strcpy(errPtr->errorMsg, interp->result);
  947.     varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  948.     if (varValue == NULL) {
  949.     varValue = errPtr->errorMsg;
  950.     }
  951.     errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
  952.     strcpy(errPtr->errorInfo, varValue);
  953.     varValue = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
  954.     if (varValue == NULL) {
  955.     varValue = "";
  956.     }
  957.     errPtr->errorCode = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
  958.     strcpy(errPtr->errorCode, varValue);
  959.     errPtr->nextPtr = NULL;
  960.     if (firstBgPtr == NULL) {
  961.     firstBgPtr = errPtr;
  962.     Tk_DoWhenIdle(HandleBgErrors, (ClientData) NULL);
  963.     } else {
  964.     lastBgPtr->nextPtr = errPtr;
  965.     }
  966.     lastBgPtr = errPtr;
  967.     Tcl_ResetResult(interp);
  968. }
  969.  
  970. /*
  971.  *----------------------------------------------------------------------
  972.  *
  973.  * HandleBgErrors --
  974.  *
  975.  *    This procedure is invoked as an idle handler to process all of
  976.  *    the accumulated background errors.
  977.  *
  978.  * Results:
  979.  *    None.
  980.  *
  981.  * Side effects:
  982.  *    Depends on what actions "tkerror" takes for the errors.
  983.  *
  984.  *----------------------------------------------------------------------
  985.  */
  986.  
  987. static void
  988. HandleBgErrors(clientData)
  989.     ClientData clientData;        /* Not used. */
  990. {
  991.     Tcl_Interp *interp;
  992.     char *command;
  993.     char *argv[2];
  994.     int code;
  995.     BgError *errPtr;
  996.  
  997.     while (firstBgPtr != NULL) {
  998.     interp = firstBgPtr->interp;
  999.     if (interp == NULL) {
  1000.         goto doneWithReport;
  1001.     }
  1002.  
  1003.     /*
  1004.      * Restore important state variables to what they were at
  1005.      * the time the error occurred.
  1006.      */
  1007.  
  1008.     Tcl_SetVar(interp, "errorInfo", firstBgPtr->errorInfo,
  1009.         TCL_GLOBAL_ONLY);
  1010.     Tcl_SetVar(interp, "errorCode", firstBgPtr->errorCode,
  1011.         TCL_GLOBAL_ONLY);
  1012.  
  1013.     /*
  1014.      * Create and invoke the tkerror command.
  1015.      */
  1016.  
  1017.     argv[0] = "tkerror";
  1018.     argv[1] = firstBgPtr->errorMsg;
  1019.     command = Tcl_Merge(2, argv);
  1020.     Tcl_AllowExceptions(interp);
  1021.     code = Tcl_GlobalEval(interp, command);
  1022.     ckfree(command);
  1023.     if (code == TCL_ERROR) {
  1024.         if (strcmp(interp->result, "\"tkerror\" is an invalid command name or ambiguous abbreviation") == 0) {
  1025.         fprintf(stderr, "%s\n", firstBgPtr->errorInfo);
  1026.         } else {
  1027.         fprintf(stderr, "tkerror failed to handle background error.\n");
  1028.         fprintf(stderr, "    Original error: %s\n",
  1029.             firstBgPtr->errorMsg);
  1030.         fprintf(stderr, "    Error in tkerror: %s\n", interp->result);
  1031.         }
  1032.     } else if (code == TCL_BREAK) {
  1033.         /*
  1034.          * Break means cancel any remaining error reports for this
  1035.          * interpreter.
  1036.          */
  1037.  
  1038.         for (errPtr = firstBgPtr; errPtr != NULL;
  1039.             errPtr = errPtr->nextPtr) {
  1040.         if (errPtr->interp == interp) {
  1041.             errPtr->interp = NULL;
  1042.         }
  1043.         }
  1044.     }
  1045.  
  1046.     /*
  1047.      * Discard the command and the information about the error report.
  1048.      */
  1049.  
  1050.     doneWithReport:
  1051.     ckfree(firstBgPtr->errorMsg);
  1052.     ckfree(firstBgPtr->errorInfo);
  1053.     ckfree(firstBgPtr->errorCode);
  1054.     errPtr = firstBgPtr->nextPtr;
  1055.     ckfree((char *) firstBgPtr);
  1056.     firstBgPtr = errPtr;
  1057.     }
  1058.     lastBgPtr = NULL;
  1059. }
  1060.  
  1061. /*
  1062.  *----------------------------------------------------------------------
  1063.  *
  1064.  * Tk_AfterCmd --
  1065.  *
  1066.  *    This procedure is invoked to process the "after" Tcl command.
  1067.  *    See the user documentation for details on what it does.
  1068.  *
  1069.  * Results:
  1070.  *    A standard Tcl result.
  1071.  *
  1072.  * Side effects:
  1073.  *    See the user documentation.
  1074.  *
  1075.  *----------------------------------------------------------------------
  1076.  */
  1077.  
  1078.     /* ARGSUSED */
  1079. int
  1080. Tk_AfterCmd(clientData, interp, argc, argv)
  1081.     ClientData clientData;    /* Main window associated with
  1082.                  * interpreter.  Not used.*/
  1083.     Tcl_Interp *interp;        /* Current interpreter. */
  1084.     int argc;            /* Number of arguments. */
  1085.     char **argv;        /* Argument strings. */
  1086. {
  1087.     /*
  1088.      * The variable below is used to generate unique identifiers for
  1089.      * after commands.  This id can wrap around, which can potentially
  1090.      * cause problems.  However, there are not likely to be problems
  1091.      * in practice, because after commands can only be requested to
  1092.      * about a month in the future, and wrap-around is unlikely to
  1093.      * occur in less than about 1-10 years.  Thus it's unlikely that
  1094.      * any old ids will still be around when wrap-around occurs.
  1095.      */
  1096.  
  1097.     static int nextId = 1;
  1098.     int ms, id;
  1099.     AfterInfo *afterPtr;
  1100.  
  1101.     if (argc < 2) {
  1102.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  1103.         argv[0], " milliseconds ?command? ?arg arg ...?\" or \"",
  1104.         argv[0], " cancel id|command\"", (char *) NULL);
  1105.     return TCL_ERROR;
  1106.     }
  1107.  
  1108.     if (isdigit(UCHAR(argv[1][0]))) {
  1109.     if (Tcl_GetInt(interp, argv[1], &ms) != TCL_OK) {
  1110.         return TCL_ERROR;
  1111.     }
  1112.     if (ms < 0) {
  1113.         ms = 0;
  1114.     }
  1115.     if (argc == 2) {
  1116.         Tk_Sleep(ms);
  1117.         return TCL_OK;
  1118.     }
  1119.     afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
  1120.     afterPtr->interp = interp;
  1121.     if (argc == 3) {
  1122.         afterPtr->command = (char *) ckalloc((unsigned)
  1123.             (strlen(argv[2]) + 1));
  1124.         strcpy(afterPtr->command, argv[2]);
  1125.     } else {
  1126.         afterPtr->command = Tcl_Concat(argc-2, argv+2);
  1127.     }
  1128.     afterPtr->id = nextId;
  1129.     nextId += 1;
  1130.     afterPtr->token = Tk_CreateTimerHandler(ms, AfterProc,
  1131.         (ClientData) afterPtr);
  1132.     afterPtr->nextPtr = firstAfterPtr;
  1133.     firstAfterPtr = afterPtr;
  1134.     sprintf(interp->result, "after#%d", afterPtr->id);
  1135.     } else if (strncmp(argv[1], "cancel", strlen(argv[1])) == 0) {
  1136.     char *arg;
  1137.  
  1138.     if (argc < 3) {
  1139.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1140.             argv[0], " cancel id|command\"", (char *) NULL);
  1141.         return TCL_ERROR;
  1142.     }
  1143.     if (argc == 3) {
  1144.         arg = argv[2];
  1145.     } else {
  1146.         arg = Tcl_Concat(argc-2, argv+2);
  1147.     }
  1148.     if (strncmp(arg, "after#", 6) == 0) {
  1149.         if (Tcl_GetInt(interp, arg+6, &id) != TCL_OK) {
  1150.         return TCL_ERROR;
  1151.         }
  1152.         for (afterPtr = firstAfterPtr; afterPtr != NULL;
  1153.             afterPtr = afterPtr->nextPtr) {
  1154.         if (afterPtr->id == id) {
  1155.             break;
  1156.         }
  1157.         }
  1158.     } else {
  1159.         for (afterPtr = firstAfterPtr; afterPtr != NULL;
  1160.             afterPtr = afterPtr->nextPtr) {
  1161.         if (strcmp(afterPtr->command, arg) == 0) {
  1162.             break;
  1163.         }
  1164.         }
  1165.     }
  1166.     if (arg != argv[2]) {
  1167.         ckfree(arg);
  1168.     }
  1169.     if (afterPtr != NULL) {
  1170.         if (afterPtr->token != NULL) {
  1171.         Tk_DeleteTimerHandler(afterPtr->token);
  1172.         } else {
  1173.         Tk_CancelIdleCall(AfterProc, (ClientData) afterPtr);
  1174.         }
  1175.         FreeAfterPtr(afterPtr);
  1176.     }
  1177.     } else if (strncmp(argv[1], "idle", strlen(argv[1])) == 0) {
  1178.     if (argc < 3) {
  1179.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1180.             argv[0], " idle script script ...\"", (char *) NULL);
  1181.         return TCL_ERROR;
  1182.     }
  1183.     afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
  1184.     afterPtr->interp = interp;
  1185.     if (argc == 3) {
  1186.         afterPtr->command = (char *) ckalloc((unsigned)
  1187.             (strlen(argv[2]) + 1));
  1188.         strcpy(afterPtr->command, argv[2]);
  1189.     } else {
  1190.         afterPtr->command = Tcl_Concat(argc-2, argv+2);
  1191.     }
  1192.     afterPtr->id = nextId;
  1193.     nextId += 1;
  1194.     afterPtr->token = NULL;
  1195.     afterPtr->nextPtr = firstAfterPtr;
  1196.     firstAfterPtr = afterPtr;
  1197.     Tk_DoWhenIdle(AfterProc, (ClientData) afterPtr);
  1198.     sprintf(interp->result, "after#%d", afterPtr->id);
  1199.     } else {
  1200.     Tcl_AppendResult(interp, "bad argument \"", argv[1],
  1201.         "\": must be cancel, idle, or a number", (char *) NULL);
  1202.     return TCL_ERROR;
  1203.     }
  1204.     return TCL_OK;
  1205. }
  1206.  
  1207. /*
  1208.  *----------------------------------------------------------------------
  1209.  *
  1210.  * AfterProc --
  1211.  *
  1212.  *    Timer callback to execute commands registered with the
  1213.  *    "after" command.
  1214.  *
  1215.  * Results:
  1216.  *    None.
  1217.  *
  1218.  * Side effects:
  1219.  *    Executes whatever command was specified.  If the command
  1220.  *    returns an error, then the command "tkerror" is invoked
  1221.  *    to process the error;  if tkerror fails then information
  1222.  *    about the error is output on stderr.
  1223.  *
  1224.  *----------------------------------------------------------------------
  1225.  */
  1226.  
  1227. static void
  1228. AfterProc(clientData)
  1229.     ClientData clientData;    /* Describes command to execute. */
  1230. {
  1231.     AfterInfo *afterPtr = (AfterInfo *) clientData;
  1232.     AfterInfo *prevPtr;
  1233.     int result;
  1234.  
  1235.     /*
  1236.      * First remove the callback from our list of callbacks;  otherwise
  1237.      * someone could delete the callback while it's being executed, which
  1238.      * could cause a core dump.
  1239.      */
  1240.  
  1241.     if (firstAfterPtr == afterPtr) {
  1242.     firstAfterPtr = afterPtr->nextPtr;
  1243.     } else {
  1244.     for (prevPtr = firstAfterPtr; prevPtr->nextPtr != afterPtr;
  1245.         prevPtr = prevPtr->nextPtr) {
  1246.         /* Empty loop body. */
  1247.     }
  1248.     prevPtr->nextPtr = afterPtr->nextPtr;
  1249.     }
  1250.  
  1251.     /*
  1252.      * Execute the callback.
  1253.      */
  1254.  
  1255.     result = Tcl_GlobalEval(afterPtr->interp, afterPtr->command);
  1256.     if (result != TCL_OK) {
  1257.     Tcl_AddErrorInfo(afterPtr->interp, "\n    (\"after\" script)");
  1258.     Tk_BackgroundError(afterPtr->interp);
  1259.     }
  1260.  
  1261.     /*
  1262.      * Free the memory for the callback.
  1263.      */
  1264.  
  1265.     ckfree(afterPtr->command);
  1266.     ckfree((char *) afterPtr);
  1267. }
  1268.  
  1269. /*
  1270.  *----------------------------------------------------------------------
  1271.  *
  1272.  * FreeAfterPtr --
  1273.  *
  1274.  *    This procedure removes an "after" command from the list of
  1275.  *    those that are pending and frees its resources.  This procedure
  1276.  *    does *not* cancel the timer handler;  if that's needed, the
  1277.  *    caller must do it.
  1278.  *
  1279.  * Results:
  1280.  *    None.
  1281.  *
  1282.  * Side effects:
  1283.  *    The memory associated with afterPtr is released.
  1284.  *
  1285.  *----------------------------------------------------------------------
  1286.  */
  1287.  
  1288. static void
  1289. FreeAfterPtr(afterPtr)
  1290.     AfterInfo *afterPtr;        /* Command to be deleted. */
  1291. {
  1292.     AfterInfo *prevPtr;
  1293.     if (firstAfterPtr == afterPtr) {
  1294.     firstAfterPtr = afterPtr->nextPtr;
  1295.     } else {
  1296.     for (prevPtr = firstAfterPtr; prevPtr->nextPtr != afterPtr;
  1297.         prevPtr = prevPtr->nextPtr) {
  1298.         /* Empty loop body. */
  1299.     }
  1300.     prevPtr->nextPtr = afterPtr->nextPtr;
  1301.     }
  1302.     ckfree(afterPtr->command);
  1303.     ckfree((char *) afterPtr);
  1304. }
  1305.  
  1306. /*
  1307.  *----------------------------------------------------------------------
  1308.  *
  1309.  * Tk_FileeventCmd --
  1310.  *
  1311.  *    This procedure is invoked to process the "fileevent" Tcl
  1312.  *    command. See the user documentation for details on what it does.
  1313.  *    This command is based on Mark Diekhans' "addinput" command.
  1314.  *
  1315.  * Results:
  1316.  *    A standard Tcl result.
  1317.  *
  1318.  * Side effects:
  1319.  *    See the user documentation.
  1320.  *
  1321.  *----------------------------------------------------------------------
  1322.  */
  1323.  
  1324.     /* ARGSUSED */
  1325. int
  1326. Tk_FileeventCmd(clientData, interp, argc, argv)
  1327.     ClientData clientData;    /* Main window associated with interpreter.
  1328.                  * Not used.*/
  1329.     Tcl_Interp *interp;        /* Current interpreter. */
  1330.     int argc;            /* Number of arguments. */
  1331.     char **argv;        /* Argument strings. */
  1332. {
  1333.     FILE *f;
  1334.     int index, fd, c;
  1335.     size_t length;
  1336.     FileEvent *fevPtr, *prevPtr;
  1337.  
  1338.     /*
  1339.      * Parse arguments.
  1340.      */
  1341.  
  1342.     if ((argc != 3) && (argc != 4)) {
  1343.     Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
  1344.         " fileId event ?script?", (char *) NULL);
  1345.     return TCL_ERROR;
  1346.     }
  1347.     c = argv[2][0];
  1348.     length = strlen(argv[2]);
  1349.     if ((c == 'r') && (strncmp(argv[2], "readable", length) == 0)) {
  1350.     index = 0;
  1351.     } else if ((c == 'w') && (strncmp(argv[2], "writable", length) == 0)) {
  1352.     index = 1;
  1353.     } else {
  1354.     Tcl_AppendResult(interp, "bad event name \"", argv[2],
  1355.         "\": must be readable or writable", (char *) NULL);
  1356.     return TCL_ERROR;
  1357.     }
  1358.     if (Tcl_GetOpenFile(interp, argv[1], index, 1, &f) != TCL_OK) {
  1359.     return TCL_ERROR;
  1360.     }
  1361.     fd = fileno(f);
  1362.  
  1363.     /*
  1364.      * Locate an existing file handler for this file, if one exists,
  1365.      * and make a new one if none currently exists.
  1366.      */
  1367.  
  1368.     for (fevPtr = firstFileEventPtr; ; fevPtr = fevPtr->nextPtr) {
  1369.     if (fevPtr == NULL) {
  1370.         if ((argc == 3) || (argv[3][0] == 0)) {
  1371.         return TCL_OK;
  1372.         }
  1373.         fevPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
  1374.         fevPtr->f = f;
  1375.         fevPtr->interps[0] = NULL;
  1376.         fevPtr->interps[1] = NULL;
  1377.         fevPtr->scripts[0] = NULL;
  1378.         fevPtr->scripts[1] = NULL;
  1379.         fevPtr->nextPtr = firstFileEventPtr;
  1380.         firstFileEventPtr = fevPtr;
  1381.         Tk_CreateFileHandler2(fileno(f), FileEventProc,
  1382.             (ClientData) fevPtr);
  1383.         tcl_FileCloseProc = DeleteFileEvent;
  1384.         break;
  1385.     }
  1386.     if (fevPtr->f == f) {
  1387.         break;
  1388.     }
  1389.     }
  1390.  
  1391.     /*
  1392.      * If we're just supposed to return the current script, do so.
  1393.      */
  1394.  
  1395.     if (argc == 3) {
  1396.     if (fevPtr->scripts[index] != NULL) {
  1397.         interp->result = fevPtr->scripts[index];
  1398.     }
  1399.     return TCL_OK;
  1400.     }
  1401.  
  1402.     /*
  1403.      * If we're supposed to delete the event handler, do so.
  1404.      */
  1405.  
  1406.     if (argv[3][0] == 0) {
  1407.     if (fevPtr->scripts[index] != NULL) {
  1408.         fevPtr->interps[index] = NULL;
  1409.         ckfree(fevPtr->scripts[index]);
  1410.         fevPtr->scripts[index] = NULL;
  1411.     }
  1412.     if ((fevPtr->scripts[0] == NULL) && (fevPtr->scripts[1] == NULL)) {
  1413.         if (firstFileEventPtr == fevPtr) {
  1414.         firstFileEventPtr = fevPtr->nextPtr;
  1415.         } else {
  1416.         for (prevPtr = firstFileEventPtr; prevPtr->nextPtr != fevPtr;
  1417.             prevPtr = prevPtr->nextPtr) {
  1418.             /* Empty loop body. */
  1419.         }
  1420.         prevPtr->nextPtr = fevPtr->nextPtr;
  1421.         }
  1422.         Tk_DeleteFileHandler(fileno(fevPtr->f));
  1423.         ckfree((char *) fevPtr);
  1424.     }
  1425.     return TCL_OK;
  1426.     }
  1427.  
  1428.     /*
  1429.      * This is a new handler being created.  Save its script.
  1430.      */
  1431.  
  1432.     fevPtr->interps[index] = interp;
  1433.     if (fevPtr->scripts[index] != NULL) {
  1434.     ckfree(fevPtr->scripts[index]);
  1435.     }
  1436.     fevPtr->scripts[index] = ckalloc((unsigned) (strlen(argv[3]) + 1));
  1437.     strcpy(fevPtr->scripts[index], argv[3]);
  1438.     return TCL_OK;
  1439. }
  1440.  
  1441. /*
  1442.  *----------------------------------------------------------------------
  1443.  *
  1444.  * FileEventProc --
  1445.  *
  1446.  *    This procedure is invoked by Tk's event loop to deal with file
  1447.  *    event bindings created by the "fileevent" command.
  1448.  *
  1449.  * Results:
  1450.  *    The return value is TK_FILE_HANDLED if the file was ready and
  1451.  *    a script was invoked to handle it.  Otherwise an OR-ed combination
  1452.  *    of TK_READABLE and TK_WRITABLE is returned, indicating the events
  1453.  *    that should be checked in future calls to select.
  1454.  *
  1455.  * Side effects:
  1456.  *    Whatever the event script does.
  1457.  *
  1458.  *----------------------------------------------------------------------
  1459.  */
  1460.  
  1461. static int
  1462. FileEventProc(clientData, mask, flags)
  1463.     ClientData clientData;    /* Pointer to FileEvent structure for file. */
  1464.     int mask;            /* OR-ed combination of the bits TK_READABLE,
  1465.                  * TK_WRITABLE, and TK_EXCEPTION, indicating
  1466.                  * current state of file. */
  1467.     int flags;            /* Flag bits passed to Tk_DoOneEvent;
  1468.                  * contains bits such as TK_DONT_WAIT,
  1469.                  * TK_X_EVENTS, Tk_FILE_EVENTS, etc. */
  1470. {
  1471.     FileEvent *fevPtr = (FileEvent *) clientData;
  1472.     Tcl_DString script;
  1473.     Tcl_Interp *interp;
  1474.     FILE *f;
  1475.     int code, checkMask;
  1476.  
  1477.     if (!(flags & TK_FILE_EVENTS)) {
  1478.     return 0;
  1479.     }
  1480.  
  1481.     /*
  1482.      * The code here is a little tricky, because the script for an
  1483.      * event could delete the event handler.  Thus, after we call
  1484.      * Tcl_GlobalEval we can't use fevPtr anymore.  We also have to
  1485.      * copy the script to make sure that it doesn't get freed while
  1486.      * being evaluated.
  1487.      */
  1488.  
  1489.     checkMask = 0;
  1490.     f = fevPtr->f;
  1491.     if (fevPtr->scripts[1] != NULL) {
  1492.     if (mask & TK_WRITABLE) {
  1493.         Tcl_DStringInit(&script);
  1494.         Tcl_DStringAppend(&script, fevPtr->scripts[1], -1);
  1495.         interp = fevPtr->interps[1];
  1496.         code = Tcl_GlobalEval(interp, Tcl_DStringValue(&script));
  1497.         Tcl_DStringFree(&script);
  1498.         if (code != TCL_OK) {
  1499.         goto error;
  1500.         }
  1501.         return TK_FILE_HANDLED;
  1502.     } else {
  1503.         checkMask |= TK_WRITABLE;
  1504.     }
  1505.     }
  1506.     if (fevPtr->scripts[0] != NULL) {
  1507.     if ((mask & TK_READABLE) || TK_READ_DATA_PENDING(f)) {
  1508.         Tcl_DStringInit(&script);
  1509.         Tcl_DStringAppend(&script, fevPtr->scripts[0], -1);
  1510.         interp = fevPtr->interps[0];
  1511.         code = Tcl_GlobalEval(interp, Tcl_DStringValue(&script));
  1512.         Tcl_DStringFree(&script);
  1513.         if (code != TCL_OK) {
  1514.         goto error;
  1515.         }
  1516.         return TK_FILE_HANDLED;
  1517.     } else {
  1518.         checkMask |= TK_READABLE;
  1519.     }
  1520.     }
  1521.     return checkMask;
  1522.  
  1523.     /*
  1524.      * An error occurred in the script, so we have to call
  1525.      * Tk_BackgroundError.  However, it's possible that the file ready
  1526.      * condition didn't get cleared for the file, so we could end
  1527.      * up in an infinite loop if we're not careful.  To be safe,
  1528.      * delete the event handler.
  1529.      */
  1530.  
  1531.     error:
  1532.     DeleteFileEvent(f);
  1533.     Tcl_AddErrorInfo(interp,
  1534.         "\n    (script bound to file event - binding deleted)");
  1535.     Tk_BackgroundError(interp);
  1536.     return TK_FILE_HANDLED;
  1537. }
  1538.  
  1539. /*
  1540.  *----------------------------------------------------------------------
  1541.  *
  1542.  * DeleteFileEvent --
  1543.  *
  1544.  *    This procedure is invoked to delete all file event handlers
  1545.  *    for a file.  For example, this is necessary if a file is closed,
  1546.  *    or if an error occurs in a handler for a file.
  1547.  *
  1548.  * Results:
  1549.  *    None.
  1550.  *
  1551.  * Side effects:
  1552.  *    The file event handler is removed, so it will never be invoked
  1553.  *    again.
  1554.  *
  1555.  *----------------------------------------------------------------------
  1556.  */
  1557.  
  1558. static void
  1559. DeleteFileEvent(f)
  1560.     FILE *f;            /* Stdio structure describing open file. */
  1561. {
  1562.     register FileEvent *fevPtr;
  1563.     FileEvent *prevPtr;
  1564.  
  1565.     /*
  1566.      * See if there exists a file handler for the given file.
  1567.      */
  1568.  
  1569.     for (prevPtr = NULL, fevPtr = firstFileEventPtr; ;
  1570.         prevPtr = fevPtr, fevPtr = fevPtr->nextPtr) {
  1571.     if (fevPtr == NULL) {
  1572.         return;
  1573.     }
  1574.     if (fevPtr->f == f) {
  1575.         break;
  1576.     }
  1577.     }
  1578.  
  1579.     /*
  1580.      * Unlink it from the list, then free it.
  1581.      */
  1582.  
  1583.     if (prevPtr == NULL) {
  1584.     firstFileEventPtr = fevPtr->nextPtr;
  1585.     } else {
  1586.     prevPtr->nextPtr = fevPtr->nextPtr;
  1587.     }
  1588.     Tk_DeleteFileHandler(fileno(fevPtr->f));
  1589.     if (fevPtr->scripts[0] != NULL) {
  1590.     ckfree(fevPtr->scripts[0]);
  1591.     }
  1592.     if (fevPtr->scripts[1] != NULL) {
  1593.     ckfree(fevPtr->scripts[1]);
  1594.     }
  1595.     ckfree((char *) fevPtr);
  1596. }
  1597.  
  1598. /*
  1599.  *----------------------------------------------------------------------
  1600.  *
  1601.  * TkEventCleanupProc --
  1602.  *
  1603.  *    This procedure is invoked whenever an interpreter is deleted.
  1604.  *    It deletes any file events and after commands that refer to
  1605.  *    that interpreter.
  1606.  *
  1607.  * Results:
  1608.  *    None.
  1609.  *
  1610.  * Side effects:
  1611.  *    File event handlers and after commands are removed.
  1612.  *
  1613.  *----------------------------------------------------------------------
  1614.  */
  1615.  
  1616.     /* ARGSUSED */
  1617. void
  1618. TkEventCleanupProc(clientData, interp)
  1619.     ClientData clientData;    /* Not used. */
  1620.     Tcl_Interp *interp;        /* Interpreter that is being deleted. */
  1621. {
  1622.     FileEvent *fevPtr, *prevPtr, *nextPtr;
  1623.     AfterInfo *afterPtr, *prevAfterPtr, *nextAfterPtr;
  1624.     int i;
  1625.  
  1626.     prevPtr = NULL;
  1627.     fevPtr = firstFileEventPtr;
  1628.     while (fevPtr != NULL) {
  1629.     for (i = 0; i < 2; i++) {
  1630.         if (fevPtr->interps[i] == interp) {
  1631.         fevPtr->interps[i] = NULL;
  1632.         ckfree((char *) fevPtr->scripts[i]);
  1633.         fevPtr->scripts[i] = NULL;
  1634.         }
  1635.     }
  1636.     if ((fevPtr->scripts[0] != NULL) || (fevPtr->scripts[1] != NULL)) {
  1637.         prevPtr = fevPtr;
  1638.         fevPtr = fevPtr->nextPtr;
  1639.         continue;
  1640.     }
  1641.     nextPtr = fevPtr->nextPtr;
  1642.     if (prevPtr == NULL) {
  1643.         firstFileEventPtr = nextPtr;
  1644.     } else {
  1645.         prevPtr->nextPtr = nextPtr;
  1646.     }
  1647.     Tk_DeleteFileHandler(fileno(fevPtr->f));
  1648.     ckfree((char *) fevPtr);
  1649.     fevPtr = nextPtr;
  1650.     }
  1651.  
  1652.     prevAfterPtr = NULL;
  1653.     afterPtr = firstAfterPtr;
  1654.     while (afterPtr != NULL) {
  1655.     if (afterPtr->interp != interp) {
  1656.         prevAfterPtr = afterPtr;
  1657.         afterPtr = afterPtr->nextPtr;
  1658.         continue;
  1659.     }
  1660.     nextAfterPtr = afterPtr->nextPtr;
  1661.     if (prevAfterPtr == NULL) {
  1662.         firstAfterPtr = nextAfterPtr;
  1663.     } else {
  1664.         prevAfterPtr->nextPtr = nextAfterPtr;
  1665.     }
  1666.     if (afterPtr->token != NULL) {
  1667.         Tk_DeleteTimerHandler(afterPtr->token);
  1668.     } else {
  1669.         Tk_CancelIdleCall(AfterProc, (ClientData) afterPtr);
  1670.     }
  1671.     ckfree(afterPtr->command);
  1672.     ckfree((char *) afterPtr);
  1673.     afterPtr = nextAfterPtr;
  1674.     }
  1675. }
  1676.  
  1677. /*
  1678.  *----------------------------------------------------------------------
  1679.  *
  1680.  * TkwaitCmd2 --
  1681.  *
  1682.  *    This procedure is invoked to process the "tkwait" Tcl command.
  1683.  *    See the user documentation for details on what it does.  This
  1684.  *    is a modified version of tkwait with only the "variable"
  1685.  *    option, suitable for use in stand-alone mode without the rest
  1686.  *    of Tk.  It's only used when Tk_EventInit has been called.
  1687.  *
  1688.  * Results:
  1689.  *    A standard Tcl result.
  1690.  *
  1691.  * Side effects:
  1692.  *    See the user documentation.
  1693.  *
  1694.  *----------------------------------------------------------------------
  1695.  */
  1696.  
  1697.     /* ARGSUSED */
  1698. static int
  1699. TkwaitCmd2(clientData, interp, argc, argv)
  1700.     ClientData clientData;    /* Not used. */
  1701.     Tcl_Interp *interp;        /* Current interpreter. */
  1702.     int argc;            /* Number of arguments. */
  1703.     char **argv;        /* Argument strings. */
  1704. {
  1705.     int c, done;
  1706.     size_t length;
  1707.  
  1708.     if (argc != 3) {
  1709.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  1710.         argv[0], " variable name\"", (char *) NULL);
  1711.     return TCL_ERROR;
  1712.     }
  1713.     c = argv[1][0];
  1714.     length = strlen(argv[1]);
  1715.     if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)
  1716.         && (length >= 2)) {
  1717.     Tcl_TraceVar(interp, argv[2],
  1718.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  1719.         WaitVariableProc2, (ClientData) &done);
  1720.     done = 0;
  1721.     while (!done) {
  1722.         Tk_DoOneEvent(0);
  1723.     }
  1724.     Tcl_UntraceVar(interp, argv[2],
  1725.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  1726.         WaitVariableProc2, (ClientData) &done);
  1727.     } else {
  1728.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  1729.         "\": must be variable", (char *) NULL);
  1730.     return TCL_ERROR;
  1731.     }
  1732.  
  1733.     /*
  1734.      * Clear out the interpreter's result, since it may have been set
  1735.      * by event handlers.
  1736.      */
  1737.  
  1738.     Tcl_ResetResult(interp);
  1739.     return TCL_OK;
  1740. }
  1741.  
  1742.     /* ARGSUSED */
  1743. static char *
  1744. WaitVariableProc2(clientData, interp, name1, name2, flags)
  1745.     ClientData clientData;    /* Pointer to integer to set to 1. */
  1746.     Tcl_Interp *interp;        /* Interpreter containing variable. */
  1747.     char *name1;        /* Name of variable. */
  1748.     char *name2;        /* Second part of variable name. */
  1749.     int flags;            /* Information about what happened. */
  1750. {
  1751.     int *donePtr = (int *) clientData;
  1752.  
  1753.     *donePtr = 1;
  1754.     return (char *) NULL;
  1755. }
  1756.  
  1757. /*
  1758.  *----------------------------------------------------------------------
  1759.  *
  1760.  * UpdateCmd2 --
  1761.  *
  1762.  *    This procedure is invoked to process the "update" Tcl command.
  1763.  *    See the user documentation for details on what it does.  This
  1764.  *    is a modified version of the command that doesn't deal with
  1765.  *    windows, suitable for use in stand-alone mode without the rest
  1766.  *    of Tk.  It's only used when Tk_EventInit has been called.
  1767.  *
  1768.  * Results:
  1769.  *    A standard Tcl result.
  1770.  *
  1771.  * Side effects:
  1772.  *    See the user documentation.
  1773.  *
  1774.  *----------------------------------------------------------------------
  1775.  */
  1776.  
  1777.     /* ARGSUSED */
  1778. static int
  1779. UpdateCmd2(clientData, interp, argc, argv)
  1780.     ClientData clientData;    /* Not used. */
  1781.     Tcl_Interp *interp;        /* Current interpreter. */
  1782.     int argc;            /* Number of arguments. */
  1783.     char **argv;        /* Argument strings. */
  1784. {
  1785.     int flags;
  1786.  
  1787.     if (argc == 1) {
  1788.     flags = TK_DONT_WAIT|TK_FILE_EVENTS|TK_TIMER_EVENTS|TK_IDLE_EVENTS;
  1789.     } else if (argc == 2) {
  1790.     if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
  1791.         Tcl_AppendResult(interp, "bad argument \"", argv[1],
  1792.             "\": must be idletasks", (char *) NULL);
  1793.         return TCL_ERROR;
  1794.     }
  1795.     flags = TK_IDLE_EVENTS;
  1796.     } else {
  1797.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  1798.         argv[0], " ?idletasks?\"", (char *) NULL);
  1799.     return TCL_ERROR;
  1800.     }
  1801.  
  1802.     /*
  1803.      * Handle all pending events.
  1804.      */
  1805.  
  1806.     while (Tk_DoOneEvent(flags) != 0) {
  1807.     /* Empty loop body */
  1808.     }
  1809.  
  1810.     /*
  1811.      * Must clear the interpreter's result because event handlers could
  1812.      * have executed commands.
  1813.      */
  1814.  
  1815.     Tcl_ResetResult(interp);
  1816.     return TCL_OK;
  1817. }
  1818.  
  1819. /*
  1820.  *----------------------------------------------------------------------
  1821.  *
  1822.  * Tk_EventInit --
  1823.  *
  1824.  *    This procedure is invoked from Tcl_AppInit if the Tk event stuff
  1825.  *    is being used by itself (without the rest of Tk) in an application.
  1826.  *    It creates the "after" and "fileevent" commands.
  1827.  *
  1828.  * Results:
  1829.  *    Always returns TCL_OK.
  1830.  *
  1831.  * Side effects:
  1832.  *    New commands get added to interp.
  1833.  *
  1834.  *----------------------------------------------------------------------
  1835.  */
  1836.  
  1837. int
  1838. Tk_EventInit(interp)
  1839.     Tcl_Interp *interp;        /* Interpreter in which to set up
  1840.                  * event-handling. */
  1841. {
  1842.     Tcl_CreateCommand(interp, "after", Tk_AfterCmd, (ClientData) NULL,
  1843.         (void (*)()) NULL);
  1844.     Tcl_CreateCommand(interp, "fileevent", Tk_FileeventCmd, (ClientData) NULL,
  1845.         (void (*)()) NULL);
  1846.     Tcl_CreateCommand(interp, "tkwait", TkwaitCmd2, (ClientData) NULL,
  1847.         (void (*)()) NULL);
  1848.     Tcl_CreateCommand(interp, "update", UpdateCmd2, (ClientData) NULL,
  1849.         (void (*)()) NULL);
  1850.     Tcl_CallWhenDeleted(interp, TkEventCleanupProc, (ClientData) NULL);
  1851.     return TCL_OK;
  1852. }
  1853.